\ dspaces 01.05.3 JCF
\ Implementation factor of inifini.
\ “needs inifini” to get this module
\
\ dspace constant foo
\    foo is a dataspace usable only
\    during compilation
\ dspace :init constant bar
\    bar can be used in compilation
\    and at run time. Reinitialized
\    (blank) at run time.
\ dspace id :copy constant quux
\    (needs dspacep)
\    quux can be used in compilation
\    and at run time, retaining its
\    values (up to quux :here) as of
\    when MakePRC is called. The
\    contents are saved in a 'data'
\    resource with the given id.

:NONAME ( ... addr dsp sz-1 -- ?? )
    ROT >R >R
    2@ 2DUP MemHandleLock
    2DUP @a DUP 2 U< IF
        DROP 2 THEN
    R> R@ + SWAP U<
    0= -9 AND THROW
    R> M+ 2SWAP ( p. h. )
    corou ( ... p. h. -- ?? h. )
    MemHandleUnlock THROW
;
: :@ ( a-addr dsp -- x )
    1 [ OVER COMPILE, ]
    2>R @a 2R>
;
: :c@ ( c-addr dsp -- x )
    0 [ OVER COMPILE, ]
    2>R c@a 2R>
;
: :2@ ( a-addr dsp -- x. )
    3 [ OVER COMPILE, ]
    2>R 2@a 2R>
;
: :! ( x a-addr dsp --  )
    1 [ OVER COMPILE, ]
    2>R !a 2R>
;
: :c! ( x c-addr dsp --  )
    0 [ OVER COMPILE, ]
    2>R c!a 2R>
;
: :2! ( x. a-addr dsp --  )
    3 [ OVER COMPILE, ]
    2>R 2!a 2R>
;
: :allot ( n dsp -- )
    0 SWAP 1 [ OVER COMPILE, ]
\ n p. h.
    2>R ROT >R 2DUP @a 0 R> M+
\ p. sz.
    IF -11 THROW THEN
\ p. sz
    1 OVER U< 0= -11 AND THROW
\ p. sz
    2R@ MemHandleSize DROP
\ p. sz hsz
    OVER U< IF
        NIP NIP 2R@ \ sz h.
        MemHandleUnlock THROW
        DUP 0 2R@ \ sz sz. h.
        MemHandleResize THROW
        2R@ MemHandleLock ROT
    THEN \ p. sz
    ROT ROT !a
    2R>
;
DROP

: :here ( dsp -- n )
    0 SWAP :@
;

: :, ( x dsp -- )
    DUP :here SWAP
    2 OVER :allot
    :!
;

: :c, ( c dsp -- )
    DUP :here SWAP
    1 OVER :allot
    :c!
;

:NONAME \ initializer ( dsp -- )
    >R 2. MemHandleNew
    2DUP OR 0= -256 AND THROW
    R@ 2!
    2 0 R> :!
;
: dspace ( --  dsp )
    ALIGN HERE DUP 2 CELLS ALLOT
    [ OVER COMPILE, ]
;
: :init ( dsp -- dsp )
    :NONAME OVER
    [COMPILE] LITERAL
    [ SWAP ] literalxt COMPILE,
    [COMPILE] ;
    add-ini
;

: :lock ( dsp -- addr. )
    2@ MemHandleLock
;

: :unlock ( dsp -- )
    2@ MemHandleUnlock THROW
;
